R Notebook

source('../settings/settings.R')
source('commonFunctions.R')

persons <- SELECTED_SUBJECTS
drive <- 1
inputFile <- str_interp('../data/processed/distancewise/TT1_Drive_${drive}_${distPrev}m_${distNext}m.csv', list(drive=drive, distPrev=DISTANCE_PREV, distNext=DISTANCE_NEXT))
outputFile <- str_interp("../data/processed/analysis/TT1_Drive_${drive}_PP_${distPrev}m_${distNext}m.csv", list(drive=drive, distPrev=DISTANCE_PREV, distNext=DISTANCE_NEXT))

all_Drive1 <- read.csv(inputFile)
all_Drive1$Subject <- as.factor(all_Drive1$Subject)
all_Drive1$logPerspiration <- log(all_Drive1$Perspiration)

mean_pp <- vector(mode="list", length=length(persons)) 
names(mean_pp) <- persons

std_pp <- vector(mode="list", length=length(persons)) 
names(std_pp) <- persons

# Segments
mean_pp_seg0 <- vector(mode="list", length=length(persons)) 
names(mean_pp_seg0) <- persons
mean_pp_seg1 <- vector(mode="list", length=length(persons)) 
names(mean_pp_seg1) <- persons
mean_pp_seg2 <- vector(mode="list", length=length(persons)) 
names(mean_pp_seg2) <- persons
mean_pp_seg3 <- vector(mode="list", length=length(persons)) 
names(mean_pp_seg3) <- persons
mean_pp_seg4 <- vector(mode="list", length=length(persons)) 
names(mean_pp_seg4) <- persons


for(p in persons) {
  pData <- all_Drive1[(all_Drive1$Subject==as.integer(p) | all_Drive1$Subject==p),]
  pData_act1 <- pData[pData$Activity == 1,]
  
  if(p == "41") {
    # This subjest has suspecious PP in the last phase (Phase = 4)
    pData_seg0 <- pData[pData$Phase==0 & pData$Time <= 370,]
  } else {
    pData_seg0 <- pData[pData$Phase==0,]
  }
  
  pData_seg1 <- pData[pData$Phase==1 & pData$Activity==1 & pData$Time < 110,]
  pData_seg2 <- pData[pData$Phase==2 & pData$Activity==1 & pData$Time < 250,]
  pData_seg3 <- pData[pData$Phase==3 & pData$Activity==1 & pData$Time < 350,]
  pData_seg4 <- pData[pData$Phase==4 & pData$Activity==1,]
  
  if(p == "41") {
    # This subjest has suspecious PP in the last phase (Phase = 4)
    mean_pp[[p]] <- mean(pData_act1[pData_act1$Time <= 370,]$ppLogNormalized)
  } else {
    mean_pp[[p]] <- mean(pData_act1$ppLogNormalized)
  }
  
  std_pp[[p]] <- sd(pData$ppLogNormalized)
  mean_pp_seg0[[p]] <- mean(pData_seg0$ppLogNormalized)
  mean_pp_seg1[[p]] <- mean(pData_seg1$ppLogNormalized)
  mean_pp_seg2[[p]] <- mean(pData_seg2$ppLogNormalized)
  mean_pp_seg3[[p]] <- mean(pData_seg3$ppLogNormalized)
  
  if (p == "41") {
    mean_pp_seg4[[p]] <- mean_pp[[p]]
  } else {
    mean_pp_seg4[[p]] <- mean(pData_seg4$ppLogNormalized)
  }
}

plt_AllAcc <- vector(mode="list", length=length(persons)) 
names(plt_AllAcc) <- persons

COLOR_ACC = "#02A3C8"
COLOR_PP = "#F28E8E"
COLOR_BRAKE = "#888888"

y1 <- list(
  tickfont = list(color = COLOR_ACC),
  title="Degree",
  range=c(0, max(all_Drive1$Acceleration))
)
y2 <- list(
  tickfont = list(color = COLOR_PP),
  overlaying = "y",
  side = "right",
  title = "Log Perspiration",
  showgrid = FALSE,
  range=c(-max(all_Drive1$ppLogNormalized), max(all_Drive1$ppLogNormalized))
)

for (p in persons) {
  pData <- all_Drive1[all_Drive1$Subject==as.integer(p) | all_Drive1$Subject==p,]
  
  pData_seg0 <- pData[pData$Phase==0,]
  pData_seg1 <- pData[pData$Phase==1 & pData$Activity==1 & pData$Time < 110,]
  pData_seg2 <- pData[pData$Phase==2 & pData$Activity==1 & pData$Time < 250,]
  pData_seg3 <- pData[pData$Phase==3 & pData$Activity==1 & pData$Time < 350,]
  pData_seg4 <- pData[pData$Phase==4 & pData$Activity==1,]
  
  plot_Acc <- plot_ly(pData, x = ~Time, height=400, width=900) %>%
    # add_trace(name="Acceleration", y = ~Acceleration, type = 'scatter', mode = 'lines', line=list(width=1.5, color=COLOR_ACC)) %>% 
    add_trace(name="PP", y = ~ppLogNormalized, type = 'scatter', mode = 'lines', connectgaps=F, line=list(width=1.5, color=COLOR_PP), yaxis = "y2") %>%
    add_segments(x = min(pData$Time), xend = max(pData$Time), y = mean_pp[[p]], yend = mean_pp[[p]],
                           yaxis = "y2", name="Avg. PP (straight)",
                           line=list(color="darkgray", dash = 'dot')) %>%
    add_segments(x = min(pData$Time), xend = max(pData$Time), y = mean_pp_seg0[[p]], yend = mean_pp_seg0[[p]], 
                           yaxis = "y2", name="Avg. PP (turning)",
                           line=list(color="black", dash = 'dot')) %>%
    add_segments(x = min(pData_seg1$Time), xend = max(pData_seg1$Time), y = mean_pp_seg1[[p]], yend = mean_pp_seg1[[p]], 
                           yaxis = "y2", name="Avg. PP (1st part)",
                           line=list(color="red", dash = 'dot')) %>%
    add_segments(x = min(pData_seg2$Time), xend = max(pData_seg2$Time), y = mean_pp_seg2[[p]], yend = mean_pp_seg2[[p]], 
                           yaxis = "y2", name="Avg. PP (2nd part)",
                           line=list(color="green", dash = 'dot')) %>%
    add_segments(x = min(pData_seg3$Time), xend = max(pData_seg3$Time), y = mean_pp_seg3[[p]], yend = mean_pp_seg3[[p]], 
                           yaxis = "y2", name="Avg. PP (3rd part)",
                           line=list(color="blue", dash = 'dot')) %>%
    add_segments(x = min(pData_seg4$Time), xend = max(pData_seg4$Time), y = mean_pp_seg4[[p]], yend = mean_pp_seg4[[p]], 
                           yaxis = "y2", name="Avg. PP (4th part)",
                           line=list(color="purple", dash = 'dot')) %>%
    layout(
      title=paste0("Subject #", p), 
      xaxis=list(title="Time [s]", range=c(0)), 
      yaxis=y1, 
      yaxis2=y2, 
      margin = list(l = 50, r = 50, b = 50, t = 50, pad = 4),
      legend = list(x = 0.5, xanchor = "center", y = -0.4, bgcolor = "rgba(0,0,0,0)", title="Metric", orientation = "h"),
      autosize = F
    )
  
  plt_AllAcc[[p]] <- plot_Acc
}

no non-missing arguments to min; returning Infno non-missing arguments to max; returning -Inf

htmltools::tagList(plt_AllAcc)

NUMBER_OF_CLUSTERS = 3

color_darkpink = "#e75480"
CLUSTER_BRANCH_COLORS <- c("blue", "darkred", color_darkpink, "black")[1:NUMBER_OF_CLUSTERS]
CLUSTER_LABEL_COLORS <- c("blue", "darkred", color_darkpink, "black")[1:NUMBER_OF_CLUSTERS]


dfPP <- as.data.frame(cbind(
                            unlist(mean_pp), 
                            unlist(std_pp), 
                            unlist(mean_pp_seg0), 
                            unlist(mean_pp_seg1), 
                            unlist(mean_pp_seg2), 
                            unlist(mean_pp_seg3), 
                            unlist(mean_pp_seg4)))

names(dfPP) <- c("MeanPP", "StdPP", "MeanPP_Seg0", "MeanPP_Seg1", "MeanPP_Seg2", "MeanPP_Seg3", "MeanPP_Seg4")
behavioralMatrixClustering <- as.matrix(dfPP)

distMatrix <- dist(behavioralMatrixClustering)
hresults <- distMatrix %>% hclust

hc <- hresults %>% 
      as.dendrogram %>%
      set("nodes_cex", NUMBER_OF_CLUSTERS) %>%
      set("labels_col", value = CLUSTER_LABEL_COLORS, k=NUMBER_OF_CLUSTERS) %>%
      # set("leaves_pch", 19) %>%
      # set("leaves_col", value = c("gray"), k=NUMBER_OF_CLUSTERS) %>%    
      set("branches_k_color", value=CLUSTER_BRANCH_COLORS, k=NUMBER_OF_CLUSTERS)

plot(hc)
legend("topright", 
     title="Drive=Cognitive \nHierachical Clustering",
     legend = c("Group 1", "Group 2", "Group 3"), 
     col = c("darkred", "pink" , "blue"),
     pch = c(20,20,20), bty = "n",  pt.cex = 1.5, cex = 0.8 , 
     text.col = "black", horiz = FALSE, inset = c(0.4, 0.1))

# Store analysis data
dfx <- dfPP
dfx <- cbind(persons, dfx)
names(dfx) <- c("Subject", names(dfPP))
write.csv(dfx, outputFile, row.names = F)

Linear Model

sampledData <- getSampleSegmentedData(NA, all_Drive1, window=WINDOW_TIME)
linearModelOnline <- lmer(ppNext ~ 
              (1 | Subject)
              + Speed_u
              + Speed_std
              + Acc_u
              + Acc_std
              + Brake_u
              + Brake_std
              + Steering_u
              + Steering_std, 
            data=sampledData, REML = T)

# lmer(ppLogNormalized ~ (1 | Subject) + Speed_u + Speed_std + Acc_u + Acc_std + Brake_u + Brake_std + Steering_u + Steering_std + HR + BR, data = pData, REML = T)

# anova(model)
summary(linearModelOnline)

Linear mixed model fit by REML. t-tests use Satterthwaite's method ['lmerModLmerTest']
Formula: ppNext ~ (1 | Subject) + Speed_u + Speed_std + Acc_u + Acc_std +      Brake_u + Brake_std + Steering_u + Steering_std
   Data: sampledData

REML criterion at convergence: -9935.5

Scaled residuals: 
    Min      1Q  Median      3Q     Max 
-6.7105 -0.5402 -0.0175  0.5512  3.7751 

Random effects:
 Groups   Name        Variance  Std.Dev.
 Subject  (Intercept) 0.0002925 0.01710 
 Residual             0.0026650 0.05162 
Number of obs: 3275, groups:  Subject, 21

Fixed effects:
               Estimate Std. Error         df t value Pr(>|t|)    
(Intercept)   1.224e-01  1.234e-02  1.281e+03   9.920  < 2e-16 ***
Speed_u      -5.814e-03  3.798e-04  3.197e+03 -15.308  < 2e-16 ***
Speed_std    -3.434e-03  1.520e-03  3.265e+03  -2.259  0.02393 *  
Acc_u         2.557e-03  4.012e-04  2.694e+03   6.372 2.18e-10 ***
Acc_std       5.077e-03  3.503e-04  3.265e+03  14.491  < 2e-16 ***
Brake_u       4.210e-03  7.247e-04  3.255e+03   5.810 6.87e-09 ***
Brake_std    -3.922e-03  7.216e-04  3.265e+03  -5.434 5.91e-08 ***
Steering_u    4.846e-05  1.176e-05  3.265e+03   4.119 3.89e-05 ***
Steering_std  1.061e-04  3.268e-05  3.264e+03   3.246  0.00118 ** 
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Correlation of Fixed Effects:
            (Intr) Speed_ Spd_st Acc_u  Acc_st Brake_ Brk_st Sterng_
Speed_u     -0.819                                                  
Speed_std   -0.157  0.056                                           
Acc_u       -0.268 -0.223  0.040                                    
Acc_std     -0.257  0.160 -0.133  0.044                             
Brake_u     -0.168  0.107 -0.068  0.148  0.102                      
Brake_std   -0.046  0.207 -0.094 -0.232 -0.300 -0.835               
Steering_u  -0.314  0.305  0.069  0.052  0.040  0.342 -0.197        
Steerng_std -0.609  0.551 -0.235  0.201  0.434  0.156 -0.164  0.070 

plot(linearModelOnline)

behavioralColumns <- BEHAVIORAL_COLUMNS
behavioralMatrix <- matrix(nrow = length(persons), ncol = length(behavioralColumns))